home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tcsel003.zip / SEARCH.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-16  |  13KB  |  293 lines
  1. program search;                                 
  2. {$A+,B-,D-,E+,F-,I+,L-,N-,O-,R-,S-,V-}
  3. {$M 16384,0,655360}
  4.  
  5.  
  6.  { Copyright 1990 Trevor J Carlsen Version 1.05  24-07-90                    }
  7.  { This program may be used and distributed as if it was in the Public Domain}
  8.  { with the following exceptions:                                            }
  9.  {    1.  If you alter it in any way, the copyright notice must not be       }
  10.  {        changed.                                                           }
  11.  {    2.  If you use code excerpts in your own programs, due credit must be  }
  12.  {        given, along with a copyright notice -                             }
  13.  {        "Parts Copyright 1990 Trevor J Carlsen"                            }
  14.  {    3.  No charge may be made for any program using code from this program.} 
  15.  
  16.  { SEARCH will scan a file or group of files and report on all occurrences   }
  17.  { of a particular string or group of characters. If found the search string }
  18.  { will be displayed along with the 79 characters preceding it and the 79    }
  19.  { characters following the line it is in.  Wild cards may be used in the    }
  20.  { filenames to be searched.                                                 }
  21.  
  22.  { If you find this program useful here is the author's contact address -    }          
  23.          
  24.  {      Trevor J Carlsen                                                     }          
  25.  {      PO Box 568                                                           }          
  26.  {      Port Hedland Western Australia 6721                                  }          
  27.  {      Voice 61 [0]91 72 2026                                               }          
  28.  {      Data  61 [0]91 72 2569                                               }          
  29.  
  30.  
  31.  
  32. uses
  33.   dos,
  34.   tpstring,  { Turbo Power's string handling library.  Procedures and        }
  35.              { functions used from this unit are -                           }
  36.              {       BMSearch                                                }
  37.              {       BMSearchUC                                              }
  38.              {       BMMakeTable                                             }
  39.              {       StUpcase                                                }
  40.   tctimer;   { A little timing routine - not needed if lines (**) removed.   }
  41.   
  42. const
  43.   bufflen     = 65000;  { Do not increase this buffer size . Ok to decrease. }
  44.   searchlen   = bufflen;
  45.   copyright1  = 'SEARCH - version 1.05 Copyright 1990 Trevor Carlsen';
  46.   copyright2  = 'All rights reserved.';
  47.  
  48. type
  49.   str79       = string[79];
  50.   buffertype  = array[0..bufflen] of byte;
  51.   buffptr     = ^buffertype;
  52.  
  53. const
  54.   space       = #32;
  55.   quote       = #34;
  56.   comma       = #44;
  57.   CaseSensitive : boolean = true;       { default is a case sensitive search }
  58. var
  59.   table       : BTable;                           { Boyer-Moore search table }
  60.   buffer      : buffptr;                             { pointer to new buffer }
  61.   f           : file;
  62.   DisplayStr  : array[0..3] of str79;
  63.   filename,
  64.   SrchStr     : string;
  65.   Slen        : byte absolute SrchStr;
  66.   
  67. procedure Asc2Str(var s, ns; max: byte);
  68.  
  69.   { Converts an array of asciiz characters to a turbo string                 }
  70.   { for speed the variable st is  effectively global and it is therefore     }
  71.   { vitally important that max is no larger than the ns untyped parameter    }
  72.   { Failure to ensure this can result in unpredictable program behaviour     }
  73.   
  74.   var starray : array[0..255] of byte absolute s;
  75.       st      : string absolute ns;
  76.       len     : byte absolute st;
  77.       
  78.   begin
  79.     move(starray[0],st[1],max);
  80.     len := max;
  81.   end; { Asc2Str }
  82.  
  83. procedure ReportError(e : byte);
  84.   { Displays a simple instruction screen in the event of insufficient        }
  85.   { parameters or certain other errors                                       }
  86.   begin
  87.     writeln('SYNTAX:');
  88.     writeln('SEARCH [-c] [path]filename searchstr');
  89.     writeln(' eg:  SEARCH c:\comm\telix\salt.doc "color"');
  90.     writeln(' or');
  91.     writeln('      SEARCH c:\comm\telix\salt.doc 13,10,13,10,13,10,13,10');
  92.     writeln(' or');
  93.     writeln('      SEARCH -c c:\*.* "MicroSoft"');
  94.     writeln;
  95.     writeln('If the -c option is used then a case insensitive search is used.');
  96.     writeln('When used the -c option must be the first parameter.');
  97.     halt(e);
  98.   end; { ReportError }
  99.  
  100. procedure ParseCommandLine;
  101.   { This procedure is really the key to everything as it parses the command  }
  102.   { line to determine what the string being searched for is.  Because the    }
  103.   { wanted string can be entered in literal form or in ascii codes this will }
  104.   { disect and determine the method used.                                    }
  105.   
  106.   var
  107.     parstr      : string;                        { contains the command line }
  108.     len         : byte absolute parstr;{ will contain the length of cmd line }
  109.     cpos, qpos,
  110.     spos, chval : byte;
  111.     error       : integer;
  112.     
  113.   begin { ParseCommandLine}
  114.     parstr    := string(ptr(PrefixSeg,$80)^);         { Get the command line }
  115.     if parstr[1] = space then
  116.       delete(parstr,1,1);  { if the first character is a space get rid of it }
  117.     spos      := pos(space,parstr);                   { find the first space }
  118.     if spos    = 0 then                   { No spaces which must be an error }
  119.       ReportError(1);   
  120.     
  121.     filename  := StUpCase(copy(parstr,1,spos-1));  { filename used as a temp }
  122.     if pos('-C',filename) = 1 then begin  { Case insensitive search required }
  123.       CaseSensitive := false;
  124.       delete(parstr,1,spos);                   { Get rid of the used portion }
  125.     end; { if pos('-C' }
  126.     spos      := pos(space,parstr);                        { find next space }
  127.     if spos    = 0 then                   { No spaces which must be an error }
  128.       ReportError(1);                     
  129.     filename  := StUpCase(copy(parstr,1,spos-1));        { Get the file mask }
  130.     delete(parstr,1,spos);                     { Get rid of the used portion }
  131.     
  132.     qpos      := pos(quote,parstr);          { look for the first quote char }
  133.     if qpos   <> 0 then begin    { quote char found - so must be quoted text }
  134.       if parstr[1] <> quote then ReportError(2);  { first char must be quote }
  135.       delete(parstr,1,1);                       { get rid of the first quote }
  136.       qpos      := pos(quote,parstr);              { and find the next quote }
  137.       if qpos = 0 then ReportError(3);  { no more quotes - so it is an error }
  138.       SrchStr   := copy(parstr,1,qpos-1);        { search string now defined }
  139.     end  { if qpos <> 0 }
  140.     
  141.     else begin                                   { must be using ascii codes }
  142.       Slen      := 0;     
  143.       cpos      := pos(comma,parstr);                     { find first comma }
  144.       if cpos = 0 then cpos := succ(len);{ No comma - so only one ascii code }
  145.       repeat                                      { create the search string }
  146.         val(copy(parstr,1,pred(cpos)),chval,error);
  147.         if error <> 0 then ReportError(7);   { there is an error so bomb out }
  148.         inc(Slen);
  149.         SrchStr[Slen] := char(chval);        { add char to the search string }
  150.         delete(parstr,1,cpos);           { get rid of used portion of parstr }
  151.         cpos  := pos(comma,parstr);                    { find the next comma }
  152.         if cpos = 0 then cpos := succ(len);    { no more commas so last char }
  153.       until len = 0;              { until whole of command line is processed }
  154.     end; { else}
  155.     
  156.     if not CaseSensitive then       { change the Search string to upper case }
  157.       SrchStr := StUpCase(SrchStr);
  158.   end; { ParseCommandLine }
  159.  
  160. function OpenFile(ofn : string): boolean;  { open a file for BlockRead/Write }
  161.   var
  162.     error : word;
  163.   begin { OpenFile}
  164.     assign(f,ofn);
  165.     {$I-} reset(f,1); {$I+}
  166.     error := IOResult;
  167.     if error <> 0 then
  168.       writeln('Cannot open ',ofn);
  169.     OpenFile := error = 0;
  170.   end; { OpenFile }
  171.  
  172. procedure CloseFile;
  173.   begin
  174.     {$I-}
  175.     Close(f);
  176.     if IOResult <> 0 then;    { don't worry too much if an error occurs here }
  177.     {$I+}
  178.   end; { CloseFile }
  179.  
  180. procedure SearchFile(var filename: string);
  181.   { Reads a file into the buffer and then searches that buffer for the wanted}
  182.   { string or characters.                                                    }
  183.   var
  184.     x,y,
  185.     count,
  186.     result,
  187.     bufferpos   : word;
  188.     abspos      : longint;
  189.     finished    : boolean;
  190.     
  191.   begin  { SearchFile}
  192.     BMMakeTable(SrchStr,table);          { Create a Boyer-Moore search table }
  193.     new(buffer);                     { make room on the heap for the buffers }
  194.     {$I-} BlockRead(f,buffer^,searchlen,result); {$I+}  { Fill buffer buffer }
  195.     if IOResult <> 0 then begin      { error occurred while reading the file }
  196.       CloseFile;
  197.       ReportError(11);
  198.     end; { if IOResult }
  199.     abspos       := 0;        { Initialise the absolute file position marker }
  200.     repeat
  201.       bufferpos      := 0;               { position marker in current buffer }
  202.       count          := 0;               { offset from search starting point }
  203.       finished := (result < searchlen);    { if buffer <> full no more reads }
  204.       
  205.       repeat                              { Do a BM search for search string }
  206.         if CaseSensitive then                   { do a case sensitive search }
  207.           count:=BMSearch(buffer^[bufferpos],result-bufferpos,table,SrchStr)
  208.         else                                  { do a case insensitive search }
  209.           count:=BMSearchUC(buffer^[bufferpos],result-bufferpos,table,SrchStr);
  210.         
  211.         if count <> $FFFF then begin                   { search string found }
  212.           inc(bufferpos,count);        { starting point of SrchStr in buffer }
  213.           DisplayStr[0] := HexL(abspos+bufferpos) +    { hex and decimal pos }
  214.                            form('  @######',(abspos+bufferpos) * 1.0);
  215.           if bufferpos > 79 then          { there is a line available before }
  216.             Asc2Str(buffer^[bufferpos - 79],DisplayStr[1],79)
  217.           else                          { no line available before the found }
  218.             DisplayStr[1] := '';               { position so null the string }
  219.           if (bufferpos + 79) < result then       { at least 79 chars can be }
  220.             Asc2Str(buffer^[bufferpos],DisplayStr[2],79)         { displayed }
  221.           else                         { only display what is left in buffer }
  222.             Asc2Str(buffer^[bufferpos],DisplayStr[2],result - bufferpos);
  223.           if (bufferpos + 158) < result then    { display the line following }
  224.             Asc2Str(buffer^[bufferpos + 79],DisplayStr[3],79)
  225.           else                          { no line following the found string }
  226.             DisplayStr[3] := '';                { so null the display string }
  227.           writeln;
  228.           writeln(DisplayStr[0],'   ',filename);{ display the file locations }
  229.           
  230.           for x := 1 to 3 do begin
  231.             for y := 1 to length(DisplayStr[x]) do{ filter out non-printables}
  232.               if ord(DisplayStr[x][y]) < 32 then DisplayStr[x][y] := '.';
  233.             if length(DisplayStr[x]) <> 0 then   { only display strings with }
  234.                writeln(DisplayStr[x]);                       { valid content }
  235.           end; { for x }
  236.           
  237.           inc(bufferpos,Slen);         { no need to check buffer in found st }
  238.         end;  { if count <> $ffff }
  239.         
  240.       until (bufferpos >= (result-length(SrchStr))) or (count = $ffff);
  241.       
  242.       if not finished then begin       { Fill 'er up again for another round }
  243.         inc(abspos,result - Slen);      { create overlap so no string missed }
  244.         {$I-} seek(f,abspos);
  245.         BlockRead(f,buffer^,searchlen,result); {$I+}
  246.         if IOResult <> 0 then begin
  247.           CloseFile;
  248.           ReportError(13);
  249.         end;
  250.       end; { if not finished}
  251.     until finished;
  252.     dispose(buffer);
  253.   end; { SearchFile }
  254.  
  255. procedure SearchForFiles;
  256.   var
  257.     dirinfo : SearchRec;
  258.     FullName: PathStr;
  259.     DirName : DirStr;
  260.     FName   : NameStr;
  261.     ExtName : ExtStr;
  262.     found   : boolean;
  263.   begin
  264.     FindFirst(filename,AnyFile,dirinfo);
  265.     found := DosError = 0;
  266.     if not found then begin
  267.       writeln('Cannot find ',filename);
  268.       ReportError(255);
  269.     end;
  270.     FSplit(filename,DirName,FName,ExtName);
  271.     while found do begin
  272.       if (dirinfo.Attr and 24) = 0 then begin
  273.         FullName := DirName + dirinfo.name;
  274.         if OpenFile(FullName) then begin
  275.           SearchFile(FullName);
  276.           CloseFile;
  277.         end;
  278.       end;
  279.       FindNext(dirinfo);
  280.       found := DosError = 0;
  281.     end;
  282.   end; { SearchForFiles }
  283.  
  284. begin { main}
  285.   (**) StartTimer;
  286.   writeln(copyright1);
  287.   writeln(copyright2);
  288.   ParseCommandLine;
  289.   SearchForFiles;
  290.   (**) WriteElapsedTime;
  291. end.
  292.  
  293.